home *** CD-ROM | disk | FTP | other *** search
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; ;;
- ;; EuLisp Module Copyright (C) University of Bath 1991 ;;
- ;; ;;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;
- ; File: avl-macros.em
- ; Title: AVL tree module utility
- ; Author: Julian Padget revised Arthur Norman's code.
- ;
- ; (c) Copyright 1990, University of Bath, all rights reserved
- ;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;
- ; Revisions:
- ; 21-APR-90 (Julian Padget) Code originally comes from Cambridge Lisp and
- ; was written by Arthur Norman. Mohammed Awdeh and John Fitch made it work
- ; in PSL and JAP tarted it up with defstruct and modules for EuLisp/PSL
- ; 09-NOV-90 (Keith Playford) Becomes avl.em for EuLisp compilation. Removed
- ; progs. Split macros.
- ; 10-NOV-90 (Julian Padget) Remmoved avl-prog macro having modified avl.em
- ; to make it superfluous.
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- (defmodule avl-macros
-
- ;; ( lists list-operators others classes class-names defs) ()
- (lists list-operators others classes defs
- (except (null) class-names))
-
- ()
-
- ; tree node access operators
-
- ; EuLispised (kjp)
-
- ( avl-macros)
-
- ;; (export
-
- (ldefstruct key-value ()
- ((key
- initarg key
- accessor key)
- (value
- initarg value
- accessor value))
- constructor make-key-value)
-
- (ldefstruct tree ()
- ((key-value-pair
- initarg key-value-pair
- accessor key-value-pair)
- (avl-left
- initarg avl-left
- accessor avl-left)
- (avl-right
- initarg avl-right
- accessor avl-right)
- (balance-state
- initarg balance-state
- accessor balance-state))
- constructor make-tree)
-
- (ldefstruct avl-tree ()
- ((order
- initarg order
- reader avl-tree-order)
- (equality
- initarg equality
- reader avl-tree-equality)
- (tree
- initform ()
- initarg tree
- accessor avl-tree-tree))
- constructor make-avl-tree)
-
- (defmacro avl-key (tree) `(key (key-value-pair ,tree)))
- (defmacro avl-value (tree) `(value (key-value-pair tree)))
- (defmacro avl-balanced (tree) `(eq (balance-state tree) 0))
- (defmacro avl-left-unbalanced (tree) `(eq (balance-state tree) 1))
- (defmacro avl-right-unbalanced (tree) `(eq (balance-state tree) 2))
- (defmacro avl-double-unbalanced (tree) `(eq (balance-state tree) 3))
-
- (defmacro mark-balanced (tree) `((setter balance-state) tree 0))
- (defmacro mark-left-unbalanced (tree) `((setter balance-state) tree 1))
- (defmacro mark-right-unbalanced (tree) `((setter balance-state) tree 2))
- (defmacro mark-double-unbalanced (tree) `((setter balance-state) tree 3))
-
- ;; )
-
- )
-
-